;; This file is part of scheme-GNUnet.
;; Copyright © 2012-2016, 2021-2022 GNUnet e.V.
;;
;; scheme-GNUnet is free software: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; scheme-GNUnet is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;
;; SPDX-License-Identifier: AGPL-3.0-or-later

;; @author Florian Dold (GNUnet)
;; @author Christian Grothoff (GNUnet)
;; @author Maxime Devos (scheme-GNUnet)
;;
;; @brief General-purpose message queue (priorities, numeric)
(library (gnu gnunet mq prio-prefs)
  (export priority-preference priority-preference?
	  prio-prefs
	  PRIORITY_MASK
	  prio-prefs->integer
	  prio-pref:?
	  prio-pref:prefs
	  prio-pref:prio
	  prio->integer)
  (import (only (guile) compose)
	  (gnu gnunet mq prio-prefs2)
	  (gnu extractor enum)
	  (srfi srfi-26)
	  (rnrs arithmetic bitwise)
	  (rnrs base))
  (begin
    (define (prio-prefs->integer . values)
      "Given a list of priority-preference enum values,
return its numeric value."
      (apply bitwise-ior
	     (map (compose (cute expt 2 <>) value->index) values)))

    (define-syntax prio-prefs
      (syntax-rules ()
	"Return the numeric value of the priority-preference flags
@code{pref:x} @code{...}."
	((_ pref:x ...)
	 (prio-prefs->integer
	  (symbol-value priority-preference pref:x) ...))))

    (define (prio-pref:? integer flag)
      "Is the flag @var{flag} (an enum value) set in
the integer @var{integer}?"
      (bitwise-bit-set? integer (value->index flag)))

    (define (prio-pref:prefs integer)
      "Given the numeric priority-preference value @var{integer},
return its preferences as multiple of @code{priority-preference}
enum values.  The priority bits are ignored."
      (let-syntax
	  ((bit (syntax-rules ()
		  ((_ name ...)
		   `(,@(let ((flag (symbol-value priority-preference name)))
			 (if (prio-pref:? integer flag)
			     `(,flag)
			     `()))
		     ...)))))
	(apply values
	       (bit pref:unreliable
		    pref:low-latency
		    pref:cork-allowed
		    pref:good-throughput
		    pref:out-of-order))))

    ;; Bit mask to apply to extract the priority bits.
    (define PRIORITY_MASK 4)

    (define (prio-pref:prio integer)
      "Given a numeric priority-preference value @var{integer},
return its priority type as a symbol, i.e. one of
@code{prio:background}, @code{prio:best-effort},
@code{prio:urgent} or @code{prio:critical-control}.
The preference bits are ignored."
      (case (bitwise-and integer PRIORITY_MASK)
	((0) 'prio:background)
	((1) 'prio:best-effort)
	((2) 'prio:urgent)
	((3) 'prio:critical-control)))

    (define (prio->integer sym)
      "An inverse of @var{prio-pref:prio}, not adding any
preference bits."
      (case sym
	;; Lowest priority, i.e. background traffic (i.e. NSE, FS).
	;; This is the default!
	((prio:background) 0)
	((prio:best-effort) 1)
	((prio:urgent) 2)
	;; Highest priority, control traffic (i.e. CORE/CADET KX).
	((prio:critical-control) 3)
	(else (assert #f))))))
